# calendar.tcl --
#
#       Calendar printing functions (a la Python).
#
# Note, this package uses [clock scan ...], which can only convert dates in the
# range "1902-01-01 00:00:00" to "2037-12-31 23:59:59" inclusive (tcl 8.3.2).

# Taken from http://wiki.tcl.tk/2823

package require Tcl 8
package require textutil
package provide calendar 0.1

namespace eval ::calendar {
    variable month_days {31 28 31 30 31 30 31 31 30 31 30 31}

    variable day_names [list]
    for {set day 2} {$day <= 8} {incr day} {
	set date [clock scan "2001-12-${day}"]
	lappend day_names [clock format $date -format "%a"]
    }

    variable month_names [list]
    for {set month 1} {$month <= 12} {incr month} {
	set mon [format "%02d" $month]
	set date [clock scan "2001-${month}-01"]
	lappend month_names [clock format $date -format "%B"]
    }

    # firstweekday=0 ~ sunday, firstweekday=1 ~ monday
    variable firstweekday 0

    variable monthcalendar_cache
    array set monthcalendar_cache {}

    namespace export isleap leapdays
    namespace export validatedate weekday monthrange
    namespace export setfirstweekday monthcalendar month calendar

    namespace import ::textutil::strRepeat ::textutil::adjust
}

# ::calendar::isleap --
#
#       Return true if year is a leap year, false otherwise

proc ::calendar::isleap {year} {
    return [expr {($year % 4 == 0) && (($year % 100 != 0) || ($year % 400 == 0))}]
}

# ::calendar::leapdays --
#
#       Calculate the number of leap days in the range of years from
#       "year1" up to, but not including, "year2".

proc ::calendar::leapdays {year1 year2} {
    if {$year1 > $year2} {
	# swap year1, year2
	foreach {year2 year1} [list $year1 $year2] {break}
    }
    incr year1 -1
    incr year2 -1
    return [expr {($year2/4 - $year1/4) - ($year2/100 - $year1/100) + ($year2/400 - $year1/400)}]
}

# ::calendar::validatedate --
#
#       Validates a given date, "year-month-day":
#               - each element is an integer
#               - the month and day are legal
#
# Returns:
#       1 if year-month-day is a valid date, else
#       throws an error with a message indicating the "failure mode"

proc ::calendar::validatedate {year month day} {
    foreach item {year month day} {
	if {![string is integer [set $item]]} {
	    error "$item is not an integer: [set $item]"
	}
    }
    if {$month < 1 || $month > 12} {
	error "error: month must be between 1 and 12 inclusive"
    }
    set d [DaysInMonth $year $month]
    if {$day < 1 || $day > $d} {
	error "error: day must be between 1 and $d inclusive"
    }
    return 1
}

# ::calendar::DaysInMonth --  private procedure
#
#       Return the number of days in the specified month,
#       adjusted for leap year

proc ::calendar::DaysInMonth {year month} {
    variable month_days
    set days_in_month [lindex $month_days [expr {$month - 1}]]
    if {[isleap $year] && $month == 2} {incr days_in_month}
    return $days_in_month
}

# ::calendar::weekday --
#
#       Return the weekday number of the specified day.
#       0 ~ Sunday, 1 ~ Monday, ... 6 ~ Saturday

proc ::calendar::weekday {year month day} {
    validatedate $year $month $day
    set date [format "%04d-%02d-%02d" $year $month $day]
    return [clock format [clock scan $date] -format %w]
}

# ::calendar::monthrange --
#
#       Returns a list containing the weekday number of the first day of the
#       specified month, and the number of days in the month.

proc ::calendar::monthrange {year month} {
    return [list [weekday $year $month 1] [DaysInMonth $year $month]]
}

# ::calendar::setfirstweekday --
#
#       For formatted monthly calendars, should Sunday or Monday be
#       printed as the first day of the week.
#
# Arguments:
#       day:  0 or any abbreviation of "sunday" to set Sunday as the first day
#             1 or any abbreviation of "monday" to set Monday as the first day

# CLN - This seems to be the only routine to assume English.  Others
# Would produce or test against localized values (Lunedi, etc.) if
# clock were, itself, localized.  Might you use clock format to get
# the string for sunday and monday and use _that_ instead of hard-
# coding?

proc ::calendar::setfirstweekday {day} {
    variable firstweekday
    switch -regexp -- [string tolower $day] {
	{^0$} - {^s(u(n(d(ay?)?)?)?)?$} {set firstweekday 0}
	{^1$} - {^m(o(n(d(ay?)?)?)?)?$} {set firstweekday 1}
	default {error "error: first weekday must be either sunday or monday"}
    }
}

# ::calendar::monthcalendar --
#
#       Calculate the days in each week of a month
#
# Returns:
#       A list of lists:  each row represents a week; days outside this month
#       are zero.

proc ::calendar::monthcalendar {year month} {
    variable monthcalendar_cache
    variable firstweekday
    if {![info exists monthcalendar_cache($year,$month,$firstweekday)]} {
	foreach {firstday ndays} [monthrange $year $month] {break}
	if {$firstweekday == 1} {
	    incr firstday [expr {$firstday == 0 ? 6 : -1}]
	}
	set themonth [list]
	set week [list]
	for {set i 0} {$i < $firstday} {incr i} {lappend week 0}
	for {set i 1} {$i <= $ndays} {incr i} {
	    if {[llength $week] == 7} {
		lappend themonth $week
		set week [list]
	    }
	    lappend week $i
	}
	for {set i [llength $week]} {$i < 7} {incr i} {lappend week 0}
	lappend themonth $week
	set monthcalendar_cache($year,$month,$firstweekday) $themonth
    }
    return $monthcalendar_cache($year,$month,$firstweekday)
}

# ::calendar::month --
#
#       Returns a formatted calendar for the specified month.
#
# Arguments:
#       year, month:  obviously, the month
#       daywidth:     the column width for each day in the week (minimum 2)
#       daylinesp:    the number of blank lines to include for each week

proc ::calendar::month {year month {daywidth 2} {daylinesp 0}} {
    variable month_names
    if {$daywidth < 2} {set daywidth 2}
    incr daylinesp
    set cal [adjust "[lindex $month_names [expr {$month - 1}]] $year" \
		 -justify center \
		 -full "true" \
		 -length [expr {7 * $daywidth + 6}]]
    append cal "\n" [FormatWeek [WeekHeader $daywidth] $daywidth] "\n"
    foreach week [monthcalendar $year $month] {
	append cal [FormatWeek $week $daywidth] [strRepeat "\n" $daylinesp]
    }
    regsub -all {\m0\M} $cal { } cal
    return $cal
}

# ::calendar::FormatWeek -- private procedure
#
#       Format the week (list of day numbers) with the specified width.

proc ::calendar::FormatWeek {week width} {
    set format "%${width}s %${width}s %${width}s %${width}s %${width}s %${width}s %${width}s"
    return [eval [concat format [list $format] $week]]
}

# ::calendar::WeekHeader -- private procedure
#
#       Return a list of day names, Sunday or Monday first.

proc ::calendar::WeekHeader {width} {
    variable firstweekday
    variable day_names
    if {$firstweekday == 0} {
	set days $day_names
    } else {
	set days [concat [lrange $day_names 1 end] [lindex $day_names 0]]
    }
    set header [list]
    incr width -1
    foreach day $days {
	lappend header [string range $day 0 $width]
    }
    return $header
}

# ::calendar::calendar --
#
#       Returns a formatted calendar for the specified year.
#
# Arguments:
#       year:         obviously, the year
#       columns:      the number of months to print in each row
#       daywidth:     the column width for each day in the week (minimum 2)
#       daylinesp:    the number of blank lines to include for each week
#       monthlinesp:  the number of blank lines to include between each month

proc ::calendar::calendar {year {columns 3} {daywidth 2} {daylinesp 0} {monthlinesp 1}} {
    incr monthlinesp -1
    set months [list]
    for {set month 1} {$month <= 12} {incr month} {
	lappend months [month $year $month $daywidth $daylinesp]
    }
    set cal ""
    set blank_week [strRepeat " " [expr {7 * $daywidth + 6}]]
    for {set i 0} {$i < 12} {incr i $columns} {
	set lines -1
	for {set j 0} {$j < $columns} {incr j 1} {
	    set m($j) [split [lindex $months [expr {$j + $i}]] "\n"]
	    if {[set l [llength $m($j)]] > $lines} {set lines $l}
	}
	for {set k 0} {$k < $lines} {incr k} {
	    set line [list]
	    for {set j 0} {$j < $columns} {incr j 1} {
		set week [lindex $m($j) $k]
		if {[string length $week] == 0} {
		    set week $blank_week
		}
		lappend line $week
	    }
	    append cal [join $line "\t"] "\n"
	}
	append cal [strRepeat "\n" $monthlinesp]
    }
    return $cal
}

